2. Content
2.1 Question 1
2.1.1 Read Data
##
## Do not execute...
##
## Remove all objects include hidden objects.
rm(list = ls(all.names = TRUE))
## get currency dataset online.
getFX('USD/JPY', from = '2014-01-01', to = '2017-01-20') #oanda only provides 180 days data. getSymbols()
#'@ USDJPY <- readRDS('./data/USDJPY.rds')
USDJPY <- xts(USDJPY[, -1], order.by = USDJPY$Date)
## dateID
dateID <- index(USDJPY)
dateID0 <- ymd('2015-01-01')
dateID <- dateID[dateID > dateID0]
obs.data <- USDJPY[index(USDJPY) > dateID0]
## Now we try to use the daily mean value which is (Hi + Lo) / 2.
pred.data <- ldply(dateID, function(dt) {
smp = USDJPY
dtr = last(index(smp[index(smp) < dt]))
smp = smp[paste0(dtr %m-% years(1), '/', dtr)]
frd = as.numeric(difftime(dt, dtr), units = 'days')
fit = ets(smp) #https://www.otexts.org/fpp/7/7
data.frame(Date = dt, forecast(fit, h = frd)) %>% tbl_df
}, .parallel = FALSE) %>% tbl_df
cmp.data <- xts(pred.data[, -1], order.by = pred.data$Date)
cmp.data <- cbind(cmp.data, obs.data)
rm(obs.data, pred.data)
# Test the models
lm(Point.Forecast~ USD.JPY, data = cmp.data)
MCMCregress(Point.Forecast~ USD.JPY, data = cmp.data)
plot(forecast(fit))
forecast(fit, h = 4)
## Mn(Fund) to retrieve the Mean column.
has.Mn <- function (x, which = FALSE) {
colAttr <- attr(x, 'Mn')
if(!is.null(colAttr))
return(if (which) colAttr else TRUE)
loc <- grep('Mean', colnames(x), ignore.case = TRUE)
if(!identical(loc, integer(0))) {
return(if (which) loc else TRUE)
} else FALSE
}
Mn <- function(x) {
if(has.Mn(x))
return(x[, grep("Mean", colnames(x), ignore.case = TRUE)])
stop("subscript out of bounds: no column name containing \"Mean\"")
}
## get currency dataset online.
## http://stackoverflow.com/questions/24219694/get-symbols-quantmod-ohlc-currency-data
#'@ getFX('USD/JPY', from = '2014-01-01', to = '2017-01-20')
## getFX() doesn't shows Op, Hi, Lo, Cl price but only price. Therefore no idea to place bets.
#'@ USDJPY <- getSymbols('JPY=X', src = 'yahoo', from = '2014-01-01',
#'@ to = '2017-01-20', auto.assign = FALSE)
#'@ names(USDJPY) <- str_replace_all(names(USDJPY), 'JPY=X', 'USDJPY')
#'@ USDJPY <- xts(USDJPY[, -1], order.by = USDJPY$Date)
#'@ saveRDS(USDJPY, './data/USDJPY.rds')
USDJPY <- read_rds(path = './data/USDJPY.rds')
2.1.2 Statistical Modelling
2.1.2.1 ARIMA vs ETS
Below are some articles with regards exponential smoothing.
- Recent Advances in Robust Statistics: Theory and Applications
- Error, trend, seasonality - ets and its forecast model friends
- A study of outliers in the exponential smoothing approach to forecasting
- 8.10 ARIMA vs ETS
- Introduction to ARIMA : nonseasonal models
It is a common myth that ARIMA models are more general than exponential smoothing. While linear exponential smoothing models are all special cases of ARIMA models, the non-linear exponential smoothing models have no equivalent ARIMA counterparts. There are also many ARIMA models that have no exponential smoothing counterparts. In particular, every ETS model2 forecast::ets() : Usually a three-character string identifying method using the framework terminology of Hyndman et al. (2002) and Hyndman et al. (2008). The first letter denotes the error type (“A”, “M” or “Z”); the second letter denotes the trend type (“N”,“A”,“M” or “Z”); and the third letter denotes the season type (“N”,“A”,“M” or “Z”). In all cases, “N”=none, “A”=additive, “M”=multiplicative and “Z”=automatically selected. So, for example, “ANN” is simple exponential smoothing with additive errors, “MAM” is multiplicative Holt-Winters’ method with multiplicative errors, and so on. It is also possible for the model to be of class “ets”, and equal to the output from a previous call to ets. In this case, the same model is fitted to y without re-estimating any smoothing parameters. See also the use.initial.values argument. is non-stationary, while ARIMA models can be stationary.
The ETS models with seasonality or non-damped trend or both have two unit roots (i.e., they need two levels of differencing to make them stationary). All other ETS models have one unit root (they need one level of differencing to make them stationary).
The following table gives some equivalence relationships for the two classes of models.
| ETS model | ARIMA model | Parameters |
|---|---|---|
| \(ETS(A, N, N)\) | \(ARIMA(0, 1, 1)\) | \(θ_{1} = α − 1\) |
| \(ETS(A, A, N)\) | \(ARIMA(0, 2, 2)\) | \(θ_{1} = α + β − 2\) |
| \(θ_{2} = 1 − α\) | ||
| \(ETS(A, A_{d}, N)\) | \(ARIMA(1, 1, 2)\) | \(ϕ_{1} = ϕ\) |
| \(θ_{1} = α + ϕβ − 1 − ϕ\) | ||
| \(θ_{2} = (1 − α)ϕ\) | ||
| \(ETS(A, N, A)\) | \(ARIMA(0, 0, m)(0, 1, 0)_{m}\) | |
| \(ETS(A, A, A)\) | \(ARIMA(0, 1, m+1)(0, 1, 0)_{m}\) | |
| \(ETS(A, A_{d}, A)\) | \(ARIMA(1, 0, m+1)(0, 1, 0)_{m}\) |
For the seasonal models, there are a large number of restrictions on the ARIMA parameters.
Kindly refer to 8.10 ARIMA vs ETS for further details.
## Now we try to use the daily mean value which is (Hi + Lo) / 2.
## Hi for predict daily highest price. (selling daytrade)
## Lo for predict daily lowest price. (buying daytrade)
simPrice <- function(mbase, .model = 'ZZZ', .damped = NULL, .additive.only = FALSE, .prCat = 'Mn', .baseDate = ymd('2015-01-01'), .parallel = FALSE, .simulate = FALSE, .bootstrap = FALSE, .npaths = 5000) {
#' Exponential smoothing state space model
#'
#' Returns ets model applied to \code{y}.
#'
#' Based on the classification of methods as described in Hyndman et al (2008).
#'
#' The methodology is fully automatic. The only required argument for ets is
#' the time series. The model is chosen automatically if not specified. This
#' methodology performed extremely well on the M3-competition data. (See
#' Hyndman, et al, 2002, below.)
#'
#'@ aliases print.ets summary.ets as.character.ets coef.ets tsdiag.ets
#'
#'@ param y a numeric vector or time series of class \code{ts}
#'@ param model Usually a three-character string identifying method using the
#' framework terminology of Hyndman et al. (2002) and Hyndman et al. (2008).
#' The first letter denotes the error type ("A", "M" or "Z"); the second letter
#' denotes the trend type ("N","A","M" or "Z"); and the third letter denotes
#' the season type ("N","A","M" or "Z"). In all cases, "N"=none, "A"=additive,
#' "M"=multiplicative and "Z"=automatically selected. So, for example, "ANN" is
#' simple exponential smoothing with additive errors, "MAM" is multiplicative
#' Holt-Winters' method with multiplicative errors, and so on.
if(!is.xts(mbase)) mbase <- xts(mbase[, -1], order.by = mbase$Date)
## dateID
dateID <- index(mbase)
if(!is.Date(.baseDate)) {
dateID0 <- ymd(.baseDate); rm(.baseDate)
} else {
dateID0 <- .baseDate; rm(.baseDate)
}
dateID <- dateID[dateID >= dateID0]
## Set as our daily settlement price.
obs.data <- mbase[index(mbase) > dateID0]
price.category <- c('Op', 'Hi', 'Mn', 'Lo', 'Cl')
if(.prCat %in% price.category) {
if(.prCat == 'Op') {
obs.data2 <- Op(mbase)
} else if(.prCat == 'Hi') {
obs.data2 <- Hi(mbase)
} else if(.prCat == 'Mn') { #mean of highest and lowest
obs.data2 <- cbind(Hi(mbase), Lo(mbase), USDJPY.Md = rowMeans(cbind(Hi(mbase), Lo(mbase))))[,-c(1:2)]
} else if(.prCat == 'Lo') {
obs.data2 <- Lo(mbase)
} else if(.prCat == 'Cl') {
obs.data2 <- Cl(mbase)
} else {
stop('Kindly choose .prCat = "Op", .prCat = "Hi", .prCat = "Mn", .prCat = "Lo" or .prCat = "Cl".')
}
} else {
stop('Kindly choose .prCat = "Op", .prCat = "Hi", .prCat = "Mn", .prCat = "Lo" or .prCat = "Cl".')
}
if(!is.character(.model)) {
stop('Kindly insert 3 characters only. First character must within c("A", "M", "Z"), c("N", "A", "M", "Z") and c("N", "A", "M", "Z").')
}
if(nchar(.model) != 3) {
stop('Kindly insert 3 characters only. First character must within c("A", "M", "Z"), c("N", "A", "M", "Z") and c("N", "A", "M", "Z").')
}
errortype <- substr(.model, 1, 1)
trendtype <- substr(.model, 2, 2)
seasontype <- substr(.model, 3, 3)
##> microbenchmark::microbenchmark(!is.element(errortype, c('A', 'M', 'Z')))
##Unit: microseconds
## expr min lq mean median uq max neval
## !is.element(errortype, c("A", "M", "Z")) 1.026 1.54 3.64893 2.053 2.053 96.479 100
##> microbenchmark::microbenchmark(errortype %in% c('A', 'M', 'Z'))
##Unit: microseconds
## expr min lq mean median uq max neval
## errortype %in% c("A", "M", "Z") 1.027 1.54 3.35126 2.0525 2.053 89.294 100
if(!errortype %in% c('A', 'M', 'Z'))
stop('Invalid error type')
if(!trendtype %in% c('N', 'A', 'M', 'Z'))
stop('Invalid trend type')
if(!seasontype %in% c('N', 'A', 'M', 'Z'))
stop('Invalid season type')
pred.data <- ldply(dateID, function(dt) {
smp = obs.data2
dtr = last(index(smp[index(smp) < dt]))
smp = smp[paste0(dtr %m-% years(1), '/', dtr)]
frd = as.numeric(difftime(dt, dtr), units = 'days')
fit = ets(smp, model = .model, damped = .damped, additive.only = .additive.only) #exponential smoothing model.
if(frd > 1) dt = seq(dt - days(frd), dt, by = 'days')[-1]
data.frame(Date = dt, forecast(fit, h = frd, simulate = .simulate,
bootstrap = .bootstrap, npaths = .npaths)) %>% tbl_df
}, .parallel = .parallel) %>% tbl_df
cmp.data <- xts(pred.data[, -1], order.by = pred.data$Date)
cmp.data <- cbind(cmp.data, obs.data)
rm(obs.data, pred.data)
return(cmp.data)
}
## Modelling
fit.op <- simPrice(USDJPY, .prCat = 'Op') #will take a minute
fit.hi <- simPrice(USDJPY, .prCat = 'Hi') #will take a minute
fit.mn <- simPrice(USDJPY, .prCat = 'Mn') #will take a minute
fit.lo <- simPrice(USDJPY, .prCat = 'Lo') #will take a minute
fit.cl <- simPrice(USDJPY, .prCat = 'Cl') #will take a minute
2.1.2.2 Garch vs eGarch
- How to fit ARMA+GARCH Model In R?
- A short introduction to the rugarch package
- A practical introduction to garch modeling
- ARCH-GARCH Example with R
- Financial Econometrics Practical Practical 6: Univariate Volatility Modelling
- Multivariate GARCH(1,1) in R
- R - Modelling Multivariate GARCH (rugarch and ccgarch)
- Introduction to some R package
- Introduction to the ruGarch package
- The rmgarch models: Background and properties. - R Project
- rmgarch - How to Multivariate GARCH Models in R | R-How.com
2.1.2.3 MCMC vs Bayesian Time Series
Need to refer to MCMC since I am using exponential smoothing models…
## Need to test and read through the MCMCregress... after few months later (when free)... Start working as a servant at Bah-Kut-Teh restorant tommorrow 01-Mar-2017.
## Test the models
## opened price fit data
summary(lm(Point.Forecast~ USDJPY.Close, data = fit.op))
##
## Call:
## lm(formula = Point.Forecast ~ USDJPY.Close, data = fit.op)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4353 -0.4004 -0.0269 0.3998 3.3978
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.180332 0.490019 0.368 0.713
## USDJPY.Close 0.998722 0.004256 234.666 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7286 on 533 degrees of freedom
## (216 observations deleted due to missingness)
## Multiple R-squared: 0.9904, Adjusted R-squared: 0.9904
## F-statistic: 5.507e+04 on 1 and 533 DF, p-value: < 2.2e-16
summary(MCMCregress(Point.Forecast~ USDJPY.Close, data = fit.op))
##
## Iterations = 1001:11000
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 10000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## (Intercept) 0.1808 0.489606 4.896e-03 4.896e-03
## USDJPY.Close 0.9987 0.004257 4.257e-05 4.257e-05
## sigma2 0.5330 0.033014 3.301e-04 3.301e-04
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## (Intercept) -0.7795 -0.1487 0.1848 0.5094 1.1441
## USDJPY.Close 0.9904 0.9959 0.9987 1.0016 1.0070
## sigma2 0.4716 0.5100 0.5317 0.5549 0.6009
## highest price fit data
summary(lm(Point.Forecast~ USDJPY.Close, data = fit.hi))
##
## Call:
## lm(formula = Point.Forecast ~ USDJPY.Close, data = fit.hi)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.3422 -0.3298 -0.0987 0.2166 3.2868
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.140616 0.379253 3.008 0.00276 **
## USDJPY.Close 0.993982 0.003294 301.765 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5639 on 533 degrees of freedom
## (216 observations deleted due to missingness)
## Multiple R-squared: 0.9942, Adjusted R-squared: 0.9942
## F-statistic: 9.106e+04 on 1 and 533 DF, p-value: < 2.2e-16
summary(MCMCregress(Point.Forecast~ USDJPY.Close, data = fit.hi))
##
## Iterations = 1001:11000
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 10000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## (Intercept) 1.1410 0.378933 3.789e-03 3.789e-03
## USDJPY.Close 0.9940 0.003295 3.295e-05 3.295e-05
## sigma2 0.3193 0.019776 1.978e-04 1.978e-04
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## (Intercept) 0.3978 0.8860 1.1441 1.3953 1.8865
## USDJPY.Close 0.9875 0.9918 0.9939 0.9962 1.0004
## sigma2 0.2825 0.3055 0.3185 0.3324 0.3599
## mean price fit data (mean price of daily highest and lowest price)
summary(lm(Point.Forecast~ USDJPY.Close, data = fit.mn))
##
## Call:
## lm(formula = Point.Forecast ~ USDJPY.Close, data = fit.mn)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.55047 -0.26416 -0.00996 0.26743 1.81654
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.106616 0.326718 0.326 0.744
## USDJPY.Close 0.999098 0.002838 352.091 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4858 on 533 degrees of freedom
## (216 observations deleted due to missingness)
## Multiple R-squared: 0.9957, Adjusted R-squared: 0.9957
## F-statistic: 1.24e+05 on 1 and 533 DF, p-value: < 2.2e-16
summary(MCMCregress(Point.Forecast~ USDJPY.Close, data = fit.mn))
##
## Iterations = 1001:11000
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 10000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## (Intercept) 0.1069 0.326443 3.264e-03 3.264e-03
## USDJPY.Close 0.9991 0.002838 2.838e-05 2.838e-05
## sigma2 0.2369 0.014676 1.468e-04 1.468e-04
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## (Intercept) -0.5333 -0.1127 0.1096 0.3260 0.7492
## USDJPY.Close 0.9935 0.9972 0.9991 1.0010 1.0046
## sigma2 0.2096 0.2267 0.2364 0.2467 0.2671
## lowest price fit data
summary(lm(Point.Forecast~ USDJPY.Close, data = fit.lo))
##
## Call:
## lm(formula = Point.Forecast ~ USDJPY.Close, data = fit.lo)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.1318 -0.2450 0.0860 0.3331 1.4818
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.3885 0.3684 -3.769 0.000182 ***
## USDJPY.Close 1.0083 0.0032 315.094 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5478 on 533 degrees of freedom
## (216 observations deleted due to missingness)
## Multiple R-squared: 0.9947, Adjusted R-squared: 0.9947
## F-statistic: 9.928e+04 on 1 and 533 DF, p-value: < 2.2e-16
summary(MCMCregress(Point.Forecast~ USDJPY.Close, data = fit.lo))
##
## Iterations = 1001:11000
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 10000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## (Intercept) -1.3881 0.368114 3.681e-03 3.681e-03
## USDJPY.Close 1.0082 0.003201 3.201e-05 3.201e-05
## sigma2 0.3013 0.018663 1.866e-04 1.866e-04
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## (Intercept) -2.1101 -1.6358 -1.3851 -1.1410 -0.6638
## USDJPY.Close 1.0020 1.0061 1.0082 1.0104 1.0145
## sigma2 0.2666 0.2883 0.3006 0.3137 0.3397
## closed price fit data
summary(lm(Point.Forecast~ USDJPY.Close, data = fit.cl))
##
## Call:
## lm(formula = Point.Forecast ~ USDJPY.Close, data = fit.cl)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.4339 -0.4026 -0.0249 0.3998 3.4032
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.17826 0.49050 0.363 0.716
## USDJPY.Close 0.99873 0.00426 234.437 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7293 on 533 degrees of freedom
## (216 observations deleted due to missingness)
## Multiple R-squared: 0.9904, Adjusted R-squared: 0.9904
## F-statistic: 5.496e+04 on 1 and 533 DF, p-value: < 2.2e-16
summary(MCMCregress(Point.Forecast~ USDJPY.Close, data = fit.cl))
##
## Iterations = 1001:11000
## Thinning interval = 1
## Number of chains = 1
## Sample size per chain = 10000
##
## 1. Empirical mean and standard deviation for each variable,
## plus standard error of the mean:
##
## Mean SD Naive SE Time-series SE
## (Intercept) 0.1787 0.490086 4.901e-03 4.901e-03
## USDJPY.Close 0.9987 0.004261 4.261e-05 4.261e-05
## sigma2 0.5340 0.033079 3.308e-04 3.308e-04
##
## 2. Quantiles for each variable:
##
## 2.5% 25% 50% 75% 97.5%
## (Intercept) -0.7825 -0.1511 0.1827 0.5077 1.1430
## USDJPY.Close 0.9904 0.9959 0.9987 1.0016 1.0071
## sigma2 0.4725 0.5110 0.5327 0.5559 0.6021
Mean Squared Error
fcdata <- do.call(cbind, list(USDJPY.FPOP.Open = fit.op$Point.Forecast,
USDJPY.FPHI.High = fit.hi$Point.Forecast,
USDJPY.FPMN.Mean = fit.mn$Point.Forecast,
USDJPY.FPLO.Low = fit.lo$Point.Forecast,
USDJPY.FPCL.Close = fit.cl$Point.Forecast,
USDJPY.Open = fit.op$USDJPY.Open,
USDJPY.High = fit.op$USDJPY.High,
USDJPY.Low = fit.op$USDJPY.Low,
USDJPY.Close = fit.op$USDJPY.Close))
fcdata <- na.omit(fcdata)
names(fcdata) <- c('USDJPY.FPOP.Open', 'USDJPY.FPHI.High', 'USDJPY.FPMN.Mean',
'USDJPY.FPLO.Low', 'USDJPY.FPCL.Close', 'USDJPY.Open',
'USDJPY.High', 'USDJPY.Low', 'USDJPY.Close')
## Mean Squared Error : comparison of accuracy
paste('Open = ', mean((fcdata$USDJPY.FPOP.Open - fcdata$USDJPY.Open)^2))
## [1] "Open = 0.524327826450961"
paste('High = ', mean((fcdata$USDJPY.FPHI.High - fcdata$USDJPY.High)^2))
## [1] "High = 0.458369038353778"
paste('Mean = ', mean((fcdata$USDJPY.FPMN.Mean - (fcdata$USDJPY.High + fcdata$USDJPY.Low)/2)^2))
## [1] "Mean = 0.414913471187317"
paste('Low = ', mean((fcdata$USDJPY.FPLO.Low - fcdata$USDJPY.Low)^2))
## [1] "Low = 0.623518861674962"
paste('Close = ', mean((fcdata$USDJPY.FPCL.Close - fcdata$USDJPY.Close)^2))
## [1] "Close = 0.531069865476858"
## Sorry ARIMA, but I’m Going Bayesian
## http://multithreaded.stitchfix.com/blog/2016/04/21/forget-arima/
#'@ library('bsts')
## Need to testing and compare the models (packages : MCMCPack and bsts).
2.1.3 Data Visualization
Plot graph.
2.1.3.1 ARIMA vs ETS
## Plot the models
## opened price fit data
autoplot(forecast(ets(fit.op$Point.Forecast), h = 4), facets = TRUE) + geom_forecast(color = '#ffcccc', show.legend = FALSE) + labs(x = 'Day', y = 'Forex Price', "Forecasts from ETS model")
#'@ ggplot(data = pd, aes(x = date, y = observed)) + geom_line(color = 'red') + geom_line(aes(y = fitted), color = "blue") + geom_line(aes(y = forecast)) + geom_ribbon(aes(ymin = lo95, ymax = hi95), alpha = .25) + scale_x_date(name = "Time in Decades") + scale_y_continuous(name = "GDP per capita (current US$)") + theme(axis.text.x = element_text(size = 10), legend.justification=c(0,1), legend.position=c(0,1)) + ggtitle("Arima(0,1,1) Fit and Forecast of GDP per capita for Brazil (1960-2013)") + scale_color_manual(values = c("Blue", "Red"), breaks = c("Fitted", "Data", "Forecast")) + ggsave((filename = "gdp_forecast_ggplot.pdf"), width=330, height=180, units=c("mm"), dpi = 300, limitsize = TRUE)
## highest price fit data
autoplot(forecast(ets(fit.hi$Point.Forecast), h = 4), facets = TRUE) + geom_forecast(color = '#FFCCCC', show.legend = FALSE) + labs(x = 'Day', y = 'Forex Price', 'Forecasts from ETS model')
## mean price fit data (mean price of daily highest and lowest price)
autoplot(forecast(ets(fit.mn$Point.Forecast), h = 4), facets = TRUE) + geom_forecast(color = '#FFCCCC', show.legend = FALSE) + labs(x = 'Day', y = 'Forex Price', 'Forecasts from ETS model')
## lowest price fit data
autoplot(forecast(ets(fit.lo$Point.Forecast), h = 4), facets = TRUE) + geom_forecast(color = '#FFCCCC', show.legend = FALSE) + labs(x = 'Day', y = 'Forex Price', 'Forecasts from ETS model')
## opened price fit data
autoplot(forecast(ets(fit.cl$Point.Forecast), h = 4), facets = TRUE) + geom_forecast(color = '#FFCCCC', show.legend = FALSE) + labs(x = 'Day', y = 'Forex Price', 'Forecasts from ETS model')
source('./function/plotChart2.R', local = TRUE)
suppressAll(rm(fit.op, fit.hi, fit.mn, fit.lo, fit.cl))
plotChart2(fcdata, initialName = 'FP', chart.type = 'FP', graph.title = 'USDJPY')
2.1.3.2 Garch vs eGarch
2.1.3.3 MCMC vs Bayesian Time Series
2.1.4 Staking Model
2.1.4.1 ARIMA vs ETS
Staking function. Here I apply Kelly criterion as the betting strategy. I don’t pretend to know the order of price flutuation flow from the Hi-Lo price range, therefore I just using Closing price for settlement while the staking price restricted within the variance (Hi-Lo) to made the transaction stand. The settled price can only be closing price unless staking price is opening price which sellable within the Hi-Lo range.
Due to we cannot know the forecasted sell/buy price and also forecasted closing price which is coming first solely from Hi-Lo data, therefore the Profit&Loss will slidely different (sell/buy price = forecasted sell/buy price).
- Forecasted profit = edge based on forecasted sell/buy price - forecasted settled price.
- If the forecasted sell/buy price doesn’t exist within the Hi-Lo price, then the transaction is not stand.
- If the forecasted settled price does not exist within the Hi-Lo price, then the settled price will be the real closing price.
simStakes <- function(mbase, .model = 'ZZZ', .damped = NULL, .additive.only = FALSE, .prCat = 'Op', .baseDate = ymd('2015-01-01'), .parallel = FALSE, .setPrice = 'Cl', .initialFundSize = 1000, .fundLeverageLog = FALSE, .filterBets = FALSE, .simulate = FALSE, .bootstrap = FALSE, .npaths = 5000) {
#' Exponential smoothing state space model
#'
#' Returns ets model applied to \code{y}.
#'
#' Based on the classification of methods as described in Hyndman et al (2008).
#'
#' The methodology is fully automatic. The only required argument for ets is
#' the time series. The model is chosen automatically if not specified. This
#' methodology performed extremely well on the M3-competition data. (See
#' Hyndman, et al, 2002, below.)
#'
#'@ aliases print.ets summary.ets as.character.ets coef.ets tsdiag.ets
#'
#'@ param y a numeric vector or time series of class \code{ts}
#'@ param model Usually a three-character string identifying method using the
#' framework terminology of Hyndman et al. (2002) and Hyndman et al. (2008).
#' The first letter denotes the error type ("A", "M" or "Z"); the second letter
#' denotes the trend type ("N","A","M" or "Z"); and the third letter denotes
#' the season type ("N","A","M" or "Z"). In all cases, "N"=none, "A"=additive,
#' "M"=multiplicative and "Z"=automatically selected. So, for example, "ANN" is
#' simple exponential smoothing with additive errors, "MAM" is multiplicative
#' Holt-Winters' method with multiplicative errors, and so on.
## .setPrice need to set by refer to closing price, otherwise the P%L will be wrong due to we unable
## know the price flow based on Hi-Lo price.
## Here I set .setPrice to options as : .setPrice = 'Op', .setPrice = 'Hi', .setPrice = 'Mn', .setPrice = 'Lo', .setPrice = 'Cl', .setPrice = 'FPOP', .setPrice = 'FPHI', .setPrice = 'FPMN', .setPrice = 'FPLO', .setPrice = 'FPCL'.
## Kindly set .initialFundSize = 1000 but not .initialFundSize = log(1000) for risk management, .fundLeverageLog = FALSE just do not exp() the log() fund size.
#'@ source('./function/simPrice.R', local = TRUE)
if(!is.numeric(.initialFundSize) & length(.initialFundSize) != 1 & .initialFundSize <= 0) {
stop('Kindly insert a numeric number as initial fund size.')
}
if(!is.character(.model)) {
stop('Kindly insert 3 characters only. First character must within c("A", "M", "Z"), c("N", "A", "M", "Z") and c("N", "A", "M", "Z").')
}
if(nchar(.model) != 3) {
stop('Kindly insert 3 characters only. First character must within c("A", "M", "Z"), c("N", "A", "M", "Z") and c("N", "A", "M", "Z").')
}
errortype <- substr(.model, 1, 1)
trendtype <- substr(.model, 2, 2)
seasontype <- substr(.model, 3, 3)
##> microbenchmark::microbenchmark(!is.element(errortype, c('A', 'M', 'Z')))
##Unit: microseconds
## expr min lq mean median uq max neval
## !is.element(errortype, c("A", "M", "Z")) 1.026 1.54 3.64893 2.053 2.053 96.479 100
##> microbenchmark::microbenchmark(errortype %in% c('A', 'M', 'Z'))
##Unit: microseconds
## expr min lq mean median uq max neval
## errortype %in% c("A", "M", "Z") 1.027 1.54 3.35126 2.0525 2.053 89.294 100
if(!errortype %in% c('A', 'M', 'Z'))
stop('Invalid error type')
if(!trendtype %in% c('N', 'A', 'M', 'Z'))
stop('Invalid trend type')
if(!seasontype %in% c('N', 'A', 'M', 'Z'))
stop('Invalid season type')
if(.fundLeverageLog == TRUE) .initialFundSize = log(.initialFundSize)
.setPriceList <- c('Op', 'Hi', 'Mn', 'Lo', 'Cl', 'FPOP', 'FPHI', 'FPMN', 'FPLO', 'FPCL')
if(.setPrice %in% .setPriceList) {
.setPrice <- .setPrice
} else {
stop("Kindly set .setPrice among c('Op', 'Hi', 'Mn', 'Lo', 'Cl', 'FPOP', 'FPHI', 'FPMN', 'FPLO', 'FPCL')")
}
nm <- str_extract_all(names(mbase), '^(.*?)+\\.') %>% unlist %>% unique
names(mbase) <- str_replace_all(names(mbase), '^(.*?)+\\.', 'USDJPY.')
## forecast staking price.
fit1 <- simPrice(mbase, .model = .model, .damped = .damped, .additive.only = .additive.only, .prCat = .prCat, .baseDate = .baseDate, .parallel = .parallel, .simulate = .simulate, .bootstrap = .bootstrap, .npaths = .npaths)
fit1 <- data.frame(Date = index(fit1), coredata(fit1)) %>% tbl_df
fit1 <- na.omit(fit1)
## forecast settlement price.
fit2 <- simPrice(mbase, .model = .model, .damped = .damped, .additive.only = .additive.only, .prCat = .setPrice, .baseDate = .baseDate, .parallel = .parallel, .simulate = .simulate, .bootstrap = .bootstrap, .npaths = .npaths)
fit2 <- data.frame(Date = index(fit2), coredata(fit2)) %>% tbl_df
fit2 <- na.omit(fit2)
## merge dataset
fitm <- cbind(fit1, forClose = fit2$Point.Forecast) %>% tbl_df
## convert to probability.
fitm %<>% mutate(ProbB = pnorm(Point.Forecast, mean = forClose, sd = sd(forClose)), ProbS = 1 - ProbB) #ProbS = pnorm(Point.Forecast, mean = forClose, sd = sd(forClose), lower.tail = FALSE)
## staking model and bankroll management.
## need to refer to Niko Martinen's fund management formula to maximise the stakes and profit base on Kelly models.
## https://github.com/scibrokes/betting-strategy-and-model-validation/blob/master/references/Creating%20a%20Profitable%20Betting%20Strategy%20for%20Football%20by%20Using%20Statistical%20Modelling.pdf
#.... dynamic staking model need to adjusted based on updated bankroll but not portion of fixed USD100 per bet.
fitm %<>% mutate(BR = .initialFundSize) %>%
#'@ mutate(Return.Back = ifelse(Prob > 0.5, Diff * Back * stakes, 0),
#'@ Return.Lay = ifelse(Prob < 0.5, -Diff * Lay * stakes, 0))
mutate(fB = 2 * ProbB - 1, fS = 2 * ProbS - 1,
EUB = ProbB * log(BR * (1 + fB)) + (1 - ProbB) * log(BR * (1 - fB)),
EUS = ProbS * log(BR * (1 + fS)) + (1 - ProbS) * log(BR * (1 - fS)),
#'@ Edge = ifelse(f > 0, EUB, EUS), #For f > 0 need to buy and f <= 0 need to sell.
#need to study on the risk management on "predicted profit" and "real profit".
Edge = ifelse(fB > 0, EUB, ifelse(fS > 0, EUS, 0)),
PF = ifelse(Point.Forecast >= USDJPY.Low &
Point.Forecast <= USDJPY.High,
Point.Forecast, 0), #if forecasted place-bet price doesn't existing within Hi-Lo price, then the buying action is not stand. Assume there has no web bandwith delay.
FC = ifelse(forClose >= USDJPY.Low & forClose <= USDJPY.High,
forClose, USDJPY.Close), #if forecasted settle price doesn't existing within Hi-Lo price, then the closing action at closing price. Assume there has no web bandwith delay.
#'@ Diff = round(forClose - USDJPY.Close, 2),
##forecasted closed price minus real close price.
Buy = ifelse(PF > 0 & FC > PF, 1, 0), ##buy action
Sell = ifelse(PF > 0 & FC < PF, 1, 0), ##sell action
BuyS = Edge * Buy * (forClose - PF),
SellS = Edge * Sell * (PF - forClose),
Profit = BuyS + SellS, Bal = BR + Profit)
#'@ fitm %>% dplyr::select(Point.Forecast, forClose, Prob, BR, f, EU, Edge, PF, FC, Buy, Sell, SP, Bal)
#'@ fitm %>% dplyr::select(ProbB, ProbS, BR, fB, fS, EUB, EUS, Edge, PF, USDJPY.Open, FC, Buy, Sell, BuyS, SellS, Profit, Bal) %>% filter(PF > 0, FC > 0)
for(i in seq(2, nrow(fitm))) {
fitm$BR[i] = fitm$Bal[i - 1]
fitm$fB[i] = 2 * fitm$ProbB[i] - 1
fitm$fS[i] = 2 * fitm$ProbS[i] - 1
fitm$EUB[i] = fitm$ProbB[i] * log(fitm$BR[i] * (1 + fitm$fB[i])) +
(1 - fitm$ProbB[i]) * log(fitm$BR[i] * (1 - fitm$fB[i]))
fitm$EUS[i] = fitm$ProbS[i] * log(fitm$BR[i] * (1 + fitm$fS[i])) +
(1 - fitm$ProbS[i]) * log(fitm$BR[i] * (1 - fitm$fS[i]))
fitm$Edge[i] = ifelse(fitm$fB[i] > 0, fitm$EUB[i],
ifelse(fitm$fS[i] > 0, fitm$EUS[i], 0)) #For f > 0 need to buy and f <= 0 need to sell.
#need to study on the risk management on "predicted profit" and "real profit".
fitm$BuyS[i] = fitm$Edge[i] * fitm$Buy[i] * (fitm$forClose[i] - fitm$PF[i])
fitm$SellS[i] = fitm$Edge[i] * fitm$Sell[i] * (fitm$PF[i] - fitm$forClose[i])
fitm$Profit[i] = fitm$BuyS[i] + fitm$SellS[i]
fitm$Bal[i] = fitm$BR[i] + fitm$Profit[i]
if(fitm$Bal[i] <= 0) stop('All invested fund ruined!')
}; rm(i)
names(mbase) <- str_replace_all(names(mbase), '^(.*?)+\\.', nm)
if(.filterBets == TRUE) {
fitm %<>% filter(PF > 0, FC > 0)
}
fitm %<>% mutate(RR = Bal/BR)
## convert the log leverage value of fund size and profit into normal digital figure with exp().
if(.fundLeverageLog == TRUE) fitm %<>% mutate(BR = exp(BR), BuyS = exp(BuyS), SellS = exp(SellS), Profit = exp(Profit), Bal = exp(Profit))
return(fitm)
}
2.1.4.2 Garch vs eGarch
2.1.4.3 MCMC vs Bayesian Time Series
2.1.5 Return of Investment
2.1.5.1 ARIMA vs ETS
Profit and Loss of default ZZZ ets models.
##============================ EVAL = FALSE ================================
##
## Model 1 without leverage.
##
## Placed orders - Fund size with log
mbase = USDJPY
fundOPHI <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Hi', .initialFundSize = 1000)
fundHIHI <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Hi', .initialFundSize = 1000)
fundMNHI <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Hi', .initialFundSize = 1000)
fundLOHI <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Hi', .initialFundSize = 1000)
fundCLHI <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Hi', .initialFundSize = 1000)
fundOPMN <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Mn', .initialFundSize = 1000)
fundHIMN <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Mn', .initialFundSize = 1000)
fundMNMN <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Mn', .initialFundSize = 1000)
fundLOMN <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Mn', .initialFundSize = 1000)
fundCLMN <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Mn', .initialFundSize = 1000)
fundOPLO <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Lo', .initialFundSize = 1000)
fundHILO <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Lo', .initialFundSize = 1000)
fundMNLO <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Lo', .initialFundSize = 1000)
fundLOLO <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Lo', .initialFundSize = 1000)
fundCLLO <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Lo', .initialFundSize = 1000)
fundOPCL <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Cl', .initialFundSize = 1000)
fundHICL <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Cl', .initialFundSize = 1000)
fundMNCL <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Cl', .initialFundSize = 1000)
fundLOCL <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Cl', .initialFundSize = 1000)
fundCLCL <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Cl', .initialFundSize = 1000)
## Placed orders - Fund size without log
#'@ fundList <- list(fundOPHI = fundOPHI, fundHIHI = fundHIHI, fundMNHI = fundMNHI, fundLOHI = fundLOHI, fundCLHI = fundCLHI,
#'@ fundOPMN = fundOPMN, fundHIMN = fundHIMN, fundMNMN = fundMNMN, fundLOMN = fundLOMN, fundCLMN = fundCLMN,
#'@ fundOPLO = fundOPLO, fundHILO = fundHILO, fundMNLO = fundMNLO, fundLOLO = fundLOLO, fundCLLO = fundCLLO,
#'@ fundOPCL = fundOPCL, fundHICL = fundHICL, fundMNCL = fundMNCL, fundLOCL = fundLOCL, fundCLCL = fundCLCL)
#'@
#'@ ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
## A tibble: 20 × 5
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
#1 fundOPHI 2015-01-02 2017-01-20 1000 326.83685 1326.837 1.326837
#2 fundHIHI 2015-01-02 2017-01-20 1000 0.00000 1000.000 1.000000
#3 fundMNHI 2015-01-02 2017-01-20 1000 152.30210 1152.302 1.152302
#4 fundLOHI 2015-01-02 2017-01-20 1000 816.63808 1816.638 1.816638
#5 fundCLHI 2015-01-02 2017-01-20 1000 323.18564 1323.186 1.323186
#6 fundOPMN 2015-01-02 2017-01-20 1000 246.68001 1246.680 1.246680
#7 fundHIMN 2015-01-02 2017-01-20 1000 384.90915 1384.909 1.384909
#8 fundMNMN 2015-01-02 2017-01-20 1000 0.00000 1000.000 1.000000
#9 fundLOMN 2015-01-02 2017-01-20 1000 529.34170 1529.342 1.529342
#10 fundCLMN 2015-01-02 2017-01-20 1000 221.03926 1221.039 1.221039
#11 fundOPLO 2015-01-02 2017-01-20 1000 268.31155 1268.312 1.268312
#12 fundHILO 2015-01-02 2017-01-20 1000 649.35074 1649.351 1.649351
#13 fundMNLO 2015-01-02 2017-01-20 1000 298.28509 1298.285 1.298285
#14 fundLOLO 2015-01-02 2017-01-20 1000 0.00000 1000.000 1.000000
#15 fundCLLO 2015-01-02 2017-01-20 1000 208.85690 1208.857 1.208857
#16 fundOPCL 2015-01-02 2017-01-20 1000 30.55969 1030.560 1.030560
#17 fundHICL 2015-01-02 2017-01-20 1000 400.59057 1400.591 1.400591
#18 fundMNCL 2015-01-02 2017-01-20 1000 117.96808 1117.968 1.117968
#19 fundLOCL 2015-01-02 2017-01-20 1000 530.68975 1530.690 1.530690
#20 fundCLCL 2015-01-02 2017-01-20 1000 0.00000 1000.000 1.000000
##============================ EVAL = FALSE ================================
##
## Leveraged model 2
##
## Placed orders - Fund size with log
fundOPHI <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Hi', .initialFundSize = log(1000))
fundHIHI <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Hi', .initialFundSize = log(1000))
fundMNHI <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Hi', .initialFundSize = log(1000))
fundLOHI <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Hi', .initialFundSize = log(1000))
fundCLHI <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Hi', .initialFundSize = log(1000))
fundOPMN <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Mn', .initialFundSize = log(1000))
fundHIMN <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Mn', .initialFundSize = log(1000))
fundMNMN <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Mn', .initialFundSize = log(1000))
fundLOMN <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Mn', .initialFundSize = log(1000))
fundCLMN <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Mn', .initialFundSize = log(1000))
fundOPLO <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Lo', .initialFundSize = log(1000))
fundHILO <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Lo', .initialFundSize = log(1000))
fundMNLO <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Lo', .initialFundSize = log(1000))
fundLOLO <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Lo', .initialFundSize = log(1000))
fundCLLO <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Lo', .initialFundSize = log(1000))
fundOPCL <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Cl', .initialFundSize = log(1000))
fundHICL <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Cl', .initialFundSize = log(1000))
fundMNCL <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Cl', .initialFundSize = log(1000))
fundLOCL <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Cl', .initialFundSize = log(1000))
fundCLCL <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Cl', .initialFundSize = log(1000))
## Placed orders - Fund size with log
#'@ fundList <- list(fundOPHI = fundOPHI, fundHIHI = fundHIHI, fundMNHI = fundMNHI, fundLOHI = fundLOHI, fundCLHI = fundCLHI,
#'@ fundOPMN = fundOPMN, fundHIMN = fundHIMN, fundMNMN = fundMNMN, fundLOMN = fundLOMN, fundCLMN = fundCLMN,
#'@ fundOPLO = fundOPLO, fundHILO = fundHILO, fundMNLO = fundMNLO, fundLOLO = fundLOLO, fundCLLO = fundCLLO,
#'@ fundOPCL = fundOPCL, fundHICL = fundHICL, fundMNCL = fundMNCL, fundLOCL = fundLOCL, fundCLCL = fundCLCL)
#'@
#'@ ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
## A tibble: 20 × 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
#1 fundOPHI 2015-01-02 2017-01-20 6.907755 201.699419 194.79166 29.198982
#2 fundHIHI 2015-01-02 2017-01-20 6.907755 6.907755 0.00000 1.000000
#3 fundMNHI 2015-01-02 2017-01-20 6.907755 75.593102 68.68535 10.943222
#4 fundLOHI 2015-01-02 2017-01-20 6.907755 592.614380 585.70662 85.789718
#5 fundCLHI 2015-01-02 2017-01-20 6.907755 199.023237 192.11548 28.811565
#6 fundOPMN 2015-01-02 2017-01-20 6.907755 145.334081 138.42633 21.039263
#7 fundHIMN 2015-01-02 2017-01-20 6.907755 245.812470 238.90472 35.585000
#8 fundMNMN 2015-01-02 2017-01-20 6.907755 6.907755 0.00000 1.000000
#9 fundLOMN 2015-01-02 2017-01-20 6.907755 359.728088 352.82033 52.075975
#10 fundCLMN 2015-01-02 2017-01-20 6.907755 127.528193 120.62044 18.461597
#11 fundOPLO 2015-01-02 2017-01-20 6.907755 159.124291 152.21654 23.035600
#12 fundHILO 2015-01-02 2017-01-20 6.907755 452.725480 445.81772 65.538726
#13 fundMNLO 2015-01-02 2017-01-20 6.907755 180.580704 173.67295 26.141734
#14 fundLOLO 2015-01-02 2017-01-20 6.907755 6.907755 0.00000 1.000000
#15 fundCLLO 2015-01-02 2017-01-20 6.907755 117.219609 110.31185 16.969276
#16 fundOPCL 2015-01-02 2017-01-20 6.907755 17.669553 10.76180 2.557930
#17 fundHICL 2015-01-02 2017-01-20 6.907755 256.110890 249.20313 37.075849
#18 fundMNCL 2015-01-02 2017-01-20 6.907755 57.745913 50.83816 8.359577
#19 fundLOCL 2015-01-02 2017-01-20 6.907755 357.560612 350.65286 51.762200
#20 fundCLCL 2015-01-02 2017-01-20 6.907755 6.907755 0.00000 1.000000
##============================ EVAL = FALSE ================================
##
## Leveraged model 3
##
## Due to the log(.initialfundSize) generates extremely high return compare to normal figure, I added a new parameter ".fundLeverageLog" which convert the normal fund size value into log into calculation and finally convert back to normal fund size figure."
## Placed orders - Fund size without log but exp() Leveraged.
#'@ fundOPHI <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Hi', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundHIHI <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Hi', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundMNHI <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Hi', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundLOHI <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Hi', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundCLHI <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Hi', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundOPMN <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Mn', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundHIMN <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Mn', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundMNMN <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Mn', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundLOMN <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Mn', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundCLMN <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Mn', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundOPLO <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Lo', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundHILO <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Lo', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundMNLO <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Lo', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundLOLO <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Lo', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundCLLO <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Lo', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundOPCL <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Cl', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundHICL <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Cl', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundMNCL <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Cl', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundLOCL <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Cl', .initialFundSize = 1000, .fundLeverageLog = TRUE)
#'@ fundCLCL <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Cl', .initialFundSize = 1000, .fundLeverageLog = TRUE)
## A tibble: 20 × 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
# 1 fundOPHI 2015-01-02 2017-01-20 1000 2.096972e+27 7.701648e+03 2.096972e+24
# 2 fundHIHI 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
# 3 fundMNHI 2015-01-02 2017-01-20 1000 3.900327e+04 1.064366e+03 3.900327e+01
# 4 fundLOHI 2015-01-02 2017-01-20 1000 2.718282e+00 9.620574e+09 2.718282e-03
# 5 fundCLHI 2015-01-02 2017-01-20 1000 6.689430e+23 6.611671e+03 6.689430e+20
# 6 fundOPMN 2015-01-02 2017-01-20 1000 2.454335e+01 1.027528e+03 2.454335e-02
# 7 fundHIMN 2015-01-02 2017-01-20 1000 2.718282e+00 2.628152e+03 2.718282e-03
# 8 fundMNMN 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
# 9 fundLOMN 2015-01-02 2017-01-20 1000 2.718282e+00 3.916608e+04 2.718282e-03
# 10 fundCLMN 2015-01-02 2017-01-20 1000 1.585667e+01 9.900735e+02 1.585667e-02
# 11 fundOPLO 2015-01-02 2017-01-20 1000 1.152381e+00 3.455387e+03 1.152381e-03
# 12 fundHILO 2015-01-02 2017-01-20 1000 2.718282e+00 1.541190e+06 2.718282e-03
# 13 fundMNLO 2015-01-02 2017-01-20 1000 1.040560e+00 3.434093e+03 1.040560e-03
# 14 fundLOLO 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
# 15 fundCLLO 2015-01-02 2017-01-20 1000 1.152544e+00 2.646148e+03 1.152544e-03
# 16 fundOPCL 2015-01-02 2017-01-20 1000 2.919029e+00 5.465890e+02 2.919029e-03
# 17 fundHICL 2015-01-02 2017-01-20 1000 2.718282e+00 2.278748e+05 2.718282e-03
# 18 fundMNCL 2015-01-02 2017-01-20 1000 1.034658e+01 9.680842e+02 1.034658e-02
# 19 fundLOCL 2015-01-02 2017-01-20 1000 2.718282e+00 2.407137e+08 2.718282e-03
# 20 fundCLCL 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
##============================ EVAL = FALSE ================================
## Profit and Loss of single model (write in list format).
#'@ cbind(
#'@ OP = df.op %>% dplyr::select(Return.Back, Return.Lay) %>% colSums %>% data.frame,
#'@ HI = df.hi %>% dplyr::select(Return.Back, Return.Lay) %>% colSums %>% data.frame,
#'@ MN = df.mn %>% dplyr::select(Return.Back, Return.Lay) %>% colSums %>% data.frame,
#'@ LO = df.lo %>% dplyr::select(Return.Back, Return.Lay) %>% colSums %>% data.frame,
#'@ CL = df.cl %>% dplyr::select(Return.Back, Return.Lay) %>% colSums %>% data.frame)
## Placed orders - Fund size with log
fundList <- list(fundOPHI = fundOPHI, fundHIHI = fundHIHI, fundMNHI = fundMNHI, fundLOHI = fundLOHI, fundCLHI = fundCLHI,
fundOPMN = fundOPMN, fundHIMN = fundHIMN, fundMNMN = fundMNMN, fundLOMN = fundLOMN, fundCLMN = fundCLMN,
fundOPLO = fundOPLO, fundHILO = fundHILO, fundMNLO = fundMNLO, fundLOLO = fundLOLO, fundCLLO = fundCLLO,
fundOPCL = fundOPCL, fundHICL = fundHICL, fundMNCL = fundMNCL, fundLOCL = fundLOCL, fundCLCL = fundCLCL)
## Summary of ROI
ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
## A tibble: 20 × 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
# 1 fundOPHI 2015-01-02 2017-01-20 1000 2.096972e+27 7.701648e+03 2.096972e+24
# 2 fundHIHI 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
# 3 fundMNHI 2015-01-02 2017-01-20 1000 3.900327e+04 1.064366e+03 3.900327e+01
# 4 fundLOHI 2015-01-02 2017-01-20 1000 2.718282e+00 9.620574e+09 2.718282e-03
# 5 fundCLHI 2015-01-02 2017-01-20 1000 6.689430e+23 6.611671e+03 6.689430e+20
# 6 fundOPMN 2015-01-02 2017-01-20 1000 2.454335e+01 1.027528e+03 2.454335e-02
# 7 fundHIMN 2015-01-02 2017-01-20 1000 2.718282e+00 2.628152e+03 2.718282e-03
# 8 fundMNMN 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
# 9 fundLOMN 2015-01-02 2017-01-20 1000 2.718282e+00 3.916608e+04 2.718282e-03
# 10 fundCLMN 2015-01-02 2017-01-20 1000 1.585667e+01 9.900735e+02 1.585667e-02
# 11 fundOPLO 2015-01-02 2017-01-20 1000 1.152381e+00 3.455387e+03 1.152381e-03
# 12 fundHILO 2015-01-02 2017-01-20 1000 2.718282e+00 1.541190e+06 2.718282e-03
# 13 fundMNLO 2015-01-02 2017-01-20 1000 1.040560e+00 3.434093e+03 1.040560e-03
# 14 fundLOLO 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
# 15 fundCLLO 2015-01-02 2017-01-20 1000 1.152544e+00 2.646148e+03 1.152544e-03
# 16 fundOPCL 2015-01-02 2017-01-20 1000 2.919029e+00 5.465890e+02 2.919029e-03
# 17 fundHICL 2015-01-02 2017-01-20 1000 2.718282e+00 2.278748e+05 2.718282e-03
# 18 fundMNCL 2015-01-02 2017-01-20 1000 1.034658e+01 9.680842e+02 1.034658e-02
# 19 fundLOCL 2015-01-02 2017-01-20 1000 2.718282e+00 2.407137e+08 2.718282e-03
# 20 fundCLCL 2015-01-02 2017-01-20 1000 2.718282e+00 5.350000e+02 2.718282e-03
## Details of ROI
llply(fundList, function(x) x[c('BR', 'fB', 'fS', 'EUB', 'EUS', 'Edge', 'PF', 'FC', 'Buy', 'Sell', 'BuyS', 'SellS', 'Profit', 'Bal', 'RR')] %>% filter(PF >0 | FC > 0))
##============================ EVAL = FALSE ================================
##
## Leveraged model 4
##
## Placed orders - Fund size with log and revert back exp() after calculation.
fundOPHI <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Hi', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundHIHI <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Hi', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundMNHI <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Hi', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundLOHI <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Hi', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundCLHI <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Hi', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundOPMN <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Mn', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundHIMN <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Mn', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundMNMN <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Mn', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundLOMN <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Mn', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundCLMN <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Mn', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundOPLO <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Lo', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundHILO <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Lo', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundMNLO <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Lo', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundLOLO <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Lo', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundCLLO <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Lo', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundOPCL <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Cl', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundHICL <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Cl', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundMNCL <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Cl', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundLOCL <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Cl', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
fundCLCL <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Cl', .initialFundSize = log(1000),
.fundLeverageLog = TRUE)
## Placed orders - Fund size with log
#'@ fundList <- list(fundOPHI = fundOPHI, fundHIHI = fundHIHI, fundMNHI = fundMNHI, fundLOHI = fundLOHI, fundCLHI = fundCLHI,
#'@ fundOPMN = fundOPMN, fundHIMN = fundHIMN, fundMNMN = fundMNMN, fundLOMN = fundLOMN, fundCLMN = fundCLMN,
#'@ fundOPLO = fundOPLO, fundHILO = fundHILO, fundMNLO = fundMNLO, fundLOLO = fundLOLO, fundCLLO = fundCLLO,
#'@ fundOPCL = fundOPCL, fundHICL = fundHICL, fundMNCL = fundMNCL, fundLOCL = fundLOCL, fundCLCL = fundCLCL)
#'@
#'@ ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
# ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
# A tibble: 20 × 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
# 1 fundOPHI 2015-01-02 2017-01-20 6.907755 7.010568e+24 6.130503e+03 1.014884e+24
# 2 fundHIHI 2015-01-02 2017-01-20 6.907755 2.718282e+00 5.350000e+02 3.935116e-01
# 3 fundMNHI 2015-01-02 2017-01-20 6.907755 2.711146e+00 5.344836e+02 3.924786e-01
# 4 fundLOHI 2015-01-02 2017-01-20 6.907755 2.718282e+00 6.039260e+09 3.935116e-01
# 5 fundCLHI 2015-01-02 2017-01-20 6.907755 5.090087e+21 5.261994e+03 7.368655e+20
# 6 fundOPMN 2015-01-02 2017-01-20 6.907755 2.198185e+01 9.372727e+02 3.182199e+00
# 7 fundHIMN 2015-01-02 2017-01-20 6.907755 2.718282e+00 2.362245e+03 3.935116e-01
# 8 fundMNMN 2015-01-02 2017-01-20 6.907755 2.718282e+00 5.350000e+02 3.935116e-01
# 9 fundLOMN 2015-01-02 2017-01-20 6.907755 2.718282e+00 3.257372e+04 3.935116e-01
# 10 fundCLMN 2015-01-02 2017-01-20 6.907755 1.441047e+01 9.002950e+02 2.086129e+00
# 11 fundOPLO 2015-01-02 2017-01-20 6.907755 1.161927e+00 2.719083e+03 1.682061e-01
# 12 fundHILO 2015-01-02 2017-01-20 6.907755 2.718282e+00 1.202578e+06 3.935116e-01
# 13 fundMNLO 2015-01-02 2017-01-20 6.907755 1.043987e+00 2.932865e+03 1.511326e-01
# 14 fundLOLO 2015-01-02 2017-01-20 6.907755 2.718282e+00 5.350000e+02 3.935116e-01
# 15 fundCLLO 2015-01-02 2017-01-20 6.907755 1.166220e+00 1.999664e+03 1.688276e-01
# 16 fundOPCL 2015-01-02 2017-01-20 6.907755 2.861825e+00 5.414756e+02 4.142917e-01
# 17 fundHICL 2015-01-02 2017-01-20 6.907755 2.718282e+00 1.639176e+05 3.935116e-01
# 18 fundMNCL 2015-01-02 2017-01-20 6.907755 7.550813e+00 7.034814e+02 1.093092e+00
# 19 fundLOCL 2015-01-02 2017-01-20 6.907755 2.718282e+00 1.359407e+08 3.935116e-01
# 20 fundCLCL 2015-01-02 2017-01-20 6.907755 2.718282e+00 5.350000e+02 3.935116e-01
From above table summary we can know that model 1 without any leverage will be growth with a stable pace where LoHi and LoHi generates highest return rates. fundLOHI indicates investment fund buy at LOwest price and sell at HIghest price and vice verse.
#4 fundLOHI 2015-01-02 2017-01-20 1000 816.63808 1816.638 1.816638
#12 fundHILO 2015-01-02 2017-01-20 1000 649.35074 1649.351 1.649351
2.1.5.2 Garch vs eGarch
2.1.5.3 MCMC vs Bayesian Time Series
2.1.6 Return of Investment Optimization
2.1.6.1 ARIMA vs ETS
Now we apply the bootstrap onto the simulation of the forecasting.
##============================ EVAL = FALSE ================================
## bootstraping simulation.
fundOPHI <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Hi', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundHIHI <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Hi', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundMNHI <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Hi', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundLOHI <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Hi', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundCLHI <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Hi', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundOPMN <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Mn', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundHIMN <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Mn', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundMNMN <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Mn', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundLOMN <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Mn', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundCLMN <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Mn', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundOPLO <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Lo', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundHILO <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Lo', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundMNLO <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Lo', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundLOLO <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Lo', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundCLLO <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Lo', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundOPCL <- simStakes(mbase, .prCat = 'Op', .setPrice = 'Cl', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundHICL <- simStakes(mbase, .prCat = 'Hi', .setPrice = 'Cl', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundMNCL <- simStakes(mbase, .prCat = 'Mn', .setPrice = 'Cl', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundLOCL <- simStakes(mbase, .prCat = 'Lo', .setPrice = 'Cl', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
fundCLCL <- simStakes(mbase, .prCat = 'Cl', .setPrice = 'Cl', .initialFundSize = 1000,
.simulate = TRUE, .bootstrap = TRUE)
## Placed orders - Fund size with log
fundList <- list(fundOPHI = fundOPHI, fundHIHI = fundHIHI, fundMNHI = fundMNHI, fundLOHI = fundLOHI, fundCLHI = fundCLHI,
fundOPMN = fundOPMN, fundHIMN = fundHIMN, fundMNMN = fundMNMN, fundLOMN = fundLOMN, fundCLMN = fundCLMN,
fundOPLO = fundOPLO, fundHILO = fundHILO, fundMNLO = fundMNLO, fundLOLO = fundLOLO, fundCLLO = fundCLLO,
fundOPCL = fundOPCL, fundHICL = fundHICL, fundMNCL = fundMNCL, fundLOCL = fundLOCL, fundCLCL = fundCLCL)
ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
## A tibble: 20 x 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
# 1 fundOPHI 2015-01-02 2017-01-20 1000 1327.136 327.13568 1.327136
# 2 fundHIHI 2015-01-02 2017-01-20 1000 1000.000 0.00000 1.000000
# 3 fundMNHI 2015-01-02 2017-01-20 1000 1152.588 152.58775 1.152588
# 4 fundLOHI 2015-01-02 2017-01-20 1000 1815.757 815.75702 1.815757
# 5 fundCLHI 2015-01-02 2017-01-20 1000 1323.481 323.48132 1.323481
# 6 fundOPMN 2015-01-02 2017-01-20 1000 1249.002 249.00240 1.249002
# 7 fundHIMN 2015-01-02 2017-01-20 1000 1384.823 384.82307 1.384823
# 8 fundMNMN 2015-01-02 2017-01-20 1000 1000.000 0.00000 1.000000
# 9 fundLOMN 2015-01-02 2017-01-20 1000 1528.111 528.11075 1.528111
#10 fundCLMN 2015-01-02 2017-01-20 1000 1222.920 222.92029 1.222920
#11 fundOPLO 2015-01-02 2017-01-20 1000 1268.312 268.31154 1.268312
#12 fundHILO 2015-01-02 2017-01-20 1000 1648.839 648.83925 1.648839
#13 fundMNLO 2015-01-02 2017-01-20 1000 1304.609 304.60943 1.304609
#14 fundLOLO 2015-01-02 2017-01-20 1000 1000.000 0.00000 1.000000
#15 fundCLLO 2015-01-02 2017-01-20 1000 1208.857 208.85688 1.208857
#16 fundOPCL 2015-01-02 2017-01-20 1000 1030.560 30.55969 1.030560
#17 fundHICL 2015-01-02 2017-01-20 1000 1400.894 400.89448 1.400894
#18 fundMNCL 2015-01-02 2017-01-20 1000 1120.002 120.00224 1.120002
#19 fundLOCL 2015-01-02 2017-01-20 1000 1530.542 530.54241 1.530542
#20 fundCLCL 2015-01-02 2017-01-20 1000 1000.000 0.00000 1.000000
## set all models provided by ets function.
ets.m1 <- c('A', 'M', 'Z')
ets.m2 <- c('N', 'A', 'M', 'Z')
ets.m3 <- c('N', 'A', 'M', 'Z')
ets.m <- do.call(paste0, expand.grid(ets.m1, ets.m2, ets.m3))
rm(ets.m1, ets.m2, ets.m3)
pp <- expand.grid(c('Op', 'Hi', 'Mn', 'Lo', 'Cl'), c('Op', 'Hi', 'Mn', 'Lo', 'Cl')) %>% mutate(PP = paste(Var1, Var2)) %>% .$PP %>% str_split(' ')
## pre-run and saved models.
##============================ EVAL = FALSE ================================
#Unit: seconds
# expr
#llply(ets.m[1:2], function(x) { simStakes(mbase, .model = x, .prCat = pp[[1]][1], .setPrice = pp[[1]][2], .initialFundSize = 1000) }, .progress = "text")
# min lq mean median uq max neval
# 46.7458 49.80663 51.08373 50.88039 52.53208 59.5116 100
#Unit: seconds
# expr
#llply(ets.m[1:2], function(x) { simStakes(mbase, .model = x, .prCat = pp[[1]][1], .setPrice = pp[[1]][2], .initialFundSize = 1000) }, .progress = "text")
# min lq mean median uq max neval
# 46.81515 47.33999 48.20982 47.98835 49.01683 51.46196 100
## .parallel and .progress parameters do not work.
##
#'@ microbenchmark(res <- llply(ets.m, function(x) {
#'@ llply(pp, function(y) {
#'@ z = simStakes(mbase, .model = x, .prCat = y[1], .setPrice = y[2], .initialFundSize = 1000, .simulate = TRUE, .bootstrap = TRUE)
#'@ txt1 <- paste0('saveRDS(z', ', file = \'./data/', x, '.', y[1], y[2], '.rds\'); rm(z)')
#'@ eval(parse(text = txt1))
#'@ cat(paste0(txt1, ' done!', '\n'))
#'@ }, .parallel = TRUE)
#'@ cat(paste(x, 'done', '\n'))
#'@ }, .parallel = TRUE))
##
microbenchmark(res <- llply(ets.m, function(x) {
llply(pp, function(y) {
z = simStakes(mbase, .model = x, .prCat = y[1], .setPrice = y[2],
.initialFundSize = 1000, .simulate = TRUE, .bootstrap = TRUE)
txt1 <- paste0('saveRDS(z', ', file = \'./data/', x, '.', y[1], y[2], '.rds\'); rm(z)')
eval(parse(text = txt1))
cat(paste0(txt1, ' done!', '\n'))
})
cat(paste(x, 'done', '\n'))
}))
#'@ sapply(ets.m, function(x) {
#'@ dir('data', pattern = x) %>% length
#'@ }, USE.NAMES = TRUE)
#ANN MNN ZNN AAN MAN ZAN AMN MMN ZMN AZN MZN ZZN ANA MNA ZNA AAA MAA ZAA AMA MMA ZMA AZA MZA ZZA ANM MNM ZNM AAM
# 25 25 25 25 25 25 0 25 25 25 25 25 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
#MAM ZAM AMM MMM ZMM AZM MZM ZZM ANZ MNZ ZNZ AAZ MAZ ZAZ AMZ MMZ ZMZ AZZ MZZ ZZZ
# 0 0 0 0 0 0 0 0 25 25 25 25 25 25 0 25 25 25 25 25
## http://r.789695.n4.nabble.com/Re-R-code-queries-td4674160.html
#'@ Error in ets(smp, model = .model) : Forbidden model combination
# ets7 <- ets(zz, model="AMN")
# Error in ets(zz, model = "AMN") : Forbidden model combination
In order to trace the errors, here I check the source codes of the function but also test the coding as you can know via Error : Forbidden model combination #554. Here I only take 22 models among 48 models.
## filtered valid models.
##============================ EVAL = FALSE ================================
> ets.m
[1] "ANN" "MNN" "ZNN" "AAN" "MAN" "ZAN" "AMN" "MMN" "ZMN" "AZN" "MZN" "ZZN" "ANA" "MNA" "ZNA" "AAA" "MAA" "ZAA"
[19] "AMA" "MMA" "ZMA" "AZA" "MZA" "ZZA" "ANM" "MNM" "ZNM" "AAM" "MAM" "ZAM" "AMM" "MMM" "ZMM" "AZM" "MZM" "ZZM"
[37] "ANZ" "MNZ" "ZNZ" "AAZ" "MAZ" "ZAZ" "AMZ" "MMZ" "ZMZ" "AZZ" "MZZ" "ZZZ"
> sapply(ets.m, function(x) {
+ dir('data', pattern = x) %>% length
+ }, USE.NAMES = TRUE) %>% .[. > 0]
ANN MNN ZNN AAN MAN ZAN MMN ZMN AZN MZN ZZN ANZ MNZ ZNZ AAZ MAZ ZAZ MMZ ZMZ AZZ MZZ ZZZ
25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25 25
> sapply(ets.m, function(x) {
+ dir('data', pattern = x) %>% length
+ }, USE.NAMES = TRUE) %>% .[. > 0] %>% length
[1] 22]
## load the pre-run and saved models.
## Profit and Loss of multi-ets models. 22 models.
nms <- sapply(ets.m, function(x) {
dir('data', pattern = x) %>% length
}, USE.NAMES = TRUE) %>% .[. > 0] %>% names
fls <- sapply(nms, function(x) {
sapply(pp, function(y) {
dir('data', pattern = paste0(x, '.', y[1], y[2]))
})
})
## From 22 ets models with 25 hilo, opcl, mnmn, opop etc different price data. There will be 550 models.
fundList <- llply(fls, function(dt) {
cbind(Model = str_replace_all(dt, '.rds', ''),
readRDS(file = paste0('./data/', dt)))
})
names(fundList) <- sapply(fundList, function(x) first(x$Model))
## Summary of ROI
ets.tbl <- ldply(fundList, function(x) { x %>% mutate(StartDate = first(Date), LatestDate = last(Date), InitFund = first(BR), LatestFund = last(Bal), Profit = sum(Profit), RR = LatestFund/InitFund) %>% dplyr::select(StartDate, LatestDate, InitFund, LatestFund, Profit, RR) %>% unique }) %>% tbl_df
## plot html table
##============================ EVAL = FALSE ================================
tagList(
tags$div(align = "center",
class = "bg-info",
tags$h3(class = "bg-primary", "Profit and Loss of Investment (2015-Jan-02 2017-Jan-20)"),
tags$h5(align = "center", class = "text-muted",
"Error-Trend-Seasonal or ExponenTial Smoothing Models")),
as.htmlwidget(ets.tbl %>% formattable(list(
LatestFund = formatter('span', style = x ~ formattable::style(color = ifelse(rank(-x) <= 3, 'blue', 'grey')), x ~ paste0(round(x, 2), ' (rank: ', sprintf('%02f', rank(-x)), ')')),
Profit = formatter('span', style = x ~ formattable::style(color = ifelse(rank(-x) <= 3, 'blue', 'grey')), x ~ paste0(round(x, 2), ' (rank: ', sprintf('%02f', rank(-x)), ')')),
RR = formatter('span', style = x ~ formattable::style(color = ifelse(rank(-x) <= 3, 'blue', 'grey')), x ~ sprintf('%1.2f%% (rank: %.0f)', 100 * x, rank(-x)))))))
## plot interactive table
ets.tbl %>% datatable(
caption = "Table 2.1.7.1 : Summary of ROI (2015-Jan-01 to 2017-Jan-20)",
escape = FALSE, filter = 'top', rownames = FALSE,
extensions = list('ColReorder' = NULL, 'RowReorder' = NULL,
'Buttons' = NULL, 'Responsive' = NULL),
options = list(dom = 'BRrltpi', autoWidth = TRUE, scrollX = TRUE,
lengthMenu = list(c(10, 50, 100, -1), c('10', '50', '100', 'All')),
ColReorder = TRUE, rowReorder = TRUE,
buttons = list('copy', 'print',
list(extend = 'collection',
buttons = c('csv', 'excel', 'pdf'),
text = 'Download'), I('colvis'))))
ets.tbl %>% filter(RR == max(RR))
## # A tibble: 2 x 7
## .id StartDate LatestDate InitFund LatestFund Profit RR
## <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
## 1 AZN.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
## 2 AZZ.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
# A tibble: 2 x 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
#1 AZN.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
#2 AZZ.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
llply(c('LoHi', 'HiLo'), function(ppr) {
ets.tbl %>% filter(.id %in% grep(ppr, ets.tbl$.id, value = TRUE)) %>% filter(RR == max(RR))
})
## [[1]]
## # A tibble: 2 x 7
## .id StartDate LatestDate InitFund LatestFund Profit RR
## <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
## 1 AZN.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
## 2 AZZ.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
##
## [[2]]
## # A tibble: 2 x 7
## .id StartDate LatestDate InitFund LatestFund Profit RR
## <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
## 1 AZN.HiLo 2015-01-02 2017-01-20 1000 1666.752 666.7518 1.666752
## 2 AZZ.HiLo 2015-01-02 2017-01-20 1000 1666.752 666.7518 1.666752
#[[1]]
# A tibble: 2 x 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
#1 AZN.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
#2 AZZ.LoHi 2015-01-02 2017-01-20 1000 1834.058 834.058 1.834058
#
#[[2]]
# A tibble: 2 x 7
# .id StartDate LatestDate InitFund LatestFund Profit RR
# <chr> <date> <date> <dbl> <dbl> <dbl> <dbl>
#1 AZN.HiLo 2015-01-02 2017-01-20 1000 1666.752 666.7518 1.666752
#2 AZZ.HiLo 2015-01-02 2017-01-20 1000 1666.752 666.7518 1.666752
From above table, we find the ets model AZN and AZZ generates highest return compare to rest of 21 ets models.
2.1.6.2 Garch vs eGarch
2.1.6.3 MCMC vs Bayesian Time Series
2.1.7 Conclusion
2.2 Question 2
When I .